home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / minor_gc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  3.2 KB  |  118 lines  |  [TEXT/MPS ]
  1. #include "config.h"
  2. #include "debugger.h"
  3. #include "fail.h"
  4. #include "gc.h"
  5. #include "major_gc.h"
  6. #include "memory.h"
  7. #include "misc.h"
  8. #include "minor_gc.h"
  9. #include "mlvalues.h"
  10. #include "roots.h"
  11.  
  12. char *young_start, *young_end, *young_ptr;
  13. static value **ref_table;
  14. static asize_t ref_table_size;
  15. value **ref_table_ptr, **ref_table_end;
  16.  
  17. void init_minor_heap (size)
  18.      asize_t size;
  19. {
  20.   if (size < 2 * Max_young_wosize) size = 2 * Max_young_wosize;
  21.   young_start = (char *) stat_alloc (size);
  22.   young_end = young_start + size;
  23.   young_ptr = young_start;
  24.   ref_table_size = 1024;
  25.   ref_table = (value **) stat_alloc (ref_table_size * sizeof (value *));
  26.   ref_table_end = ref_table + ref_table_size;
  27.   ref_table_ptr = ref_table;
  28. }
  29.  
  30. static void oldify (p, v)
  31.      value *p;
  32.      value v;
  33. {
  34.   value result;
  35.   mlsize_t i;
  36.  
  37.  tail_call:
  38.   if (Is_block (v) && Is_young (v)){
  39.     Assert (Hp_val (v) < young_ptr);
  40.     if (Is_blue_val (v)){    /* Already forwarded ? */
  41.       *p = Field (v, 0);     /* Then the forward pointer is the first field. */
  42.     }else if (Tag_val (v) >= No_scan_tag){
  43.       result = raw_alloc_shr (Wosize_val (v), Tag_val (v));
  44.       bcopy (Bp_val (v), Bp_val (result), Bosize_val (v));
  45.       Hd_val (v) = Bluehd_hd (Hd_val (v));    /* Put the forward flag. */
  46.       Field (v, 0) = result;                  /* And the forward pointer. */
  47.       *p = result;
  48.     }else{
  49.       /* We can do recursive calls before all the fields are filled, because
  50.          we will not be calling the major GC. */
  51.       value field0 = Field (v, 0);
  52.       mlsize_t sz = Wosize_val (v);
  53.  
  54.       result = raw_alloc_shr (sz, Tag_val (v));
  55.       *p = result;
  56.       Hd_val (v) = Bluehd_hd (Hd_val (v));    /* Put the forward flag. */
  57.       Field (v, 0) = result;                  /* And the forward pointer. */
  58.       if (sz == 1){
  59.         p = &Field (result, 0);
  60.         v = field0;
  61.         goto tail_call;
  62.       }else{
  63.         oldify (&Field (result, 0), field0);
  64.         for (i = 1; i < sz - 1; i++){
  65.           oldify (&Field (result, i), Field (v, i));
  66.         }
  67.         p = &Field (result, i);
  68.         v = Field (v, i);
  69.         goto tail_call;
  70.       }
  71.     }
  72.   }else{
  73.     *p = v;
  74.   }
  75. }
  76.  
  77. void minor_collection ()
  78. {
  79.   value **r;
  80.   struct longjmp_buffer raise_buf;
  81.   struct longjmp_buffer *old_external_raise;
  82.  
  83.   if (setjmp(raise_buf.buf)) {
  84.     fatal_error ("out of memory");
  85.   }
  86.   old_external_raise = external_raise;
  87.   external_raise = &raise_buf;
  88.  
  89.   gc_message ("<", 0);
  90.   local_roots (oldify);
  91.   for (r = ref_table; r < ref_table_ptr; r++) oldify (*r, **r);
  92.   young_ptr = young_start;
  93.   ref_table_ptr = ref_table;
  94.   gc_message (">", 0);
  95.  
  96.   external_raise = old_external_raise;
  97.  
  98.   major_collection_slice ();
  99. }
  100.  
  101. void realloc_ref_table ()
  102. {
  103.   Assert (ref_table_ptr == ref_table_end);
  104.   gc_message ("Growing ref_table to %ld kB.\n",
  105.           (long) ref_table_size * 2 * sizeof (value *) / 1024);
  106. #ifdef MAX_MALLOC_SIZE
  107.   if (ref_table_size > MAX_MALLOC_SIZE / (2 * sizeof(value *)))
  108.     ref_table = NULL;
  109.   else
  110. #endif
  111.   ref_table = (value **) realloc ((char *) ref_table,
  112.                   ref_table_size * 2 * sizeof (value *));
  113.   if (ref_table == NULL) fatal_error ("ref_table overflow");
  114.   ref_table_ptr = ref_table + ref_table_size;
  115.   ref_table_size *= 2;
  116.   ref_table_end = ref_table + ref_table_size;
  117. }
  118.